home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0067_VGA256 Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  5.0 KB  |  166 lines
  1. {
  2. > I'm using 320x200x256.  I use mainly assembly to do my procedures and
  3. > function in this library... but I can't manage to figure out a way to do
  4. > GET and PUTs ... have ny Idea how to do it?  And yes, if you have any nice
  5. > graphic procedures/functions, well, I'm interrested...
  6.  
  7. Ok, if you want, I can post a bitmap scaler I got from Sean Palmer... it's in
  8. assembler, so it's fast, and you could use it just like put, except it doesn't
  9. do "transparency."  If I ever figure out how to do it, I'll modify it and post
  10. it.  But for now, here are some other routines for mode 13h:
  11. }
  12.  
  13. TYPE
  14.   RGBPalette = ARRAY[0..767] OF Byte;
  15.  
  16. PROCEDURE SetVideoMode(desiredVideoMode : Byte);
  17. BEGIN ASM MOV AH,0; MOV AL,desiredVideoMode; INT $10; END; END;
  18.  
  19. FUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;
  20. BEGIN GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x]; END;
  21.  
  22. PROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);
  23. BEGIN Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c; END;
  24.  
  25. PROCEDURE Ellipse(exc, eyc, ea, eb : Integer);
  26. VAR elx, ely : Integer;
  27.   aa, aa2, bb, bb2, d, dx, dy : LongInt;
  28. BEGIN
  29.   elx:=0; ely:=eb; aa:=LongInt(ea)*ea; aa2:=2*aa;
  30.   bb:=LongInt(eb)*eb; bb2:=2*bb;
  31.   d:=bb-aa*eb+aa DIV 4; dx:=0; dy:=aa2*eb;
  32.   SetPixel(exc, eyc-ely, Colour); SetPixel(exc, eyc+ely, Colour);
  33.   SetPixel(exc-ea, eyc, Colour); SetPixel(exc+ea, eyc, Colour);
  34.   WHILE (dx < dy) DO BEGIN
  35.     IF (d > 0) THEN BEGIN
  36.       Dec(ely); Dec(dy, aa2); Dec(d, dy);
  37.     END;
  38.     Inc(elx); Inc(dx, bb2); Inc(d, bb+dx);
  39.     SetPixel(exc+elx, eyc+ely, Colour);
  40.     SetPixel(exc-elx, eyc+ely, Colour);
  41.     SetPixel(exc+elx, eyc-ely, Colour);
  42.     SetPixel(exc-elx, eyc-ely, Colour);
  43.   END;
  44.   Inc(d, (3*(aa-bb) DIV 2-(dx+dy)) DIV 2);
  45.   WHILE (ely > 0) DO BEGIN
  46.     IF (d < 0) THEN BEGIN
  47.       Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);
  48.     END;
  49.     Dec(ely); Dec(dy, aa2); Inc(d, aa-dy);
  50.     SetPixel(exc+elx, eyc+ely, Colour);
  51.     SetPixel(exc-elx, eyc+ely, Colour);
  52.     SetPixel(exc+elx, eyc-ely, Colour);
  53.     SetPixel(exc-elx, eyc-ely, Colour);
  54.   END;
  55. END;
  56.  
  57. { these routines have been "compressed" to take up less line space; I
  58.   like spaces between addition, subtraction, etc, but I took them out
  59.   to save space... you can add them again if you want }
  60.  
  61.  
  62. PROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);
  63. VAR lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;
  64. BEGIN
  65.   IF (lnx1 < lnx2) THEN BEGIN lnxi:=1; lndx:=lnx2-lnx1;
  66.   END ELSE BEGIN lnxi := (-1); lndx:= lnx1-lnx2; END;
  67.   IF (lny1 < lny2) THEN BEGIN lnyi:=1; lndy:=lny2-lny1;
  68.   END ELSE BEGIN lnyi := (-1); lndy:=lny1-lny2; END;
  69.   SetPixel(lnx1, lny1, Colour);
  70.   IF (lndx > lndy) THEN BEGIN
  71.     lnai:=(lndy-lndx)*2; lnbi:=lndy*2; lndd:=lnbi-lndx;
  72.     REPEAT
  73.       IF (lndd >= 0) THEN BEGIN
  74.         Inc(lny1, lnyi);
  75.         Inc(lndd, lnai);
  76.       END ELSE Inc(lndd, lnbi);
  77.       Inc(lnx1, lnxi);
  78.       SetPixel(lnx1, lny1, Colour);
  79.     UNTIL (lnx1 = lnx2);
  80.   END ELSE BEGIN
  81.     lnai := (lndx - lndy) * 2;
  82.     lnbi := lndx * 2;
  83.     lndd := lnbi - lndy;
  84.     REPEAT
  85.       IF (lndd >= 0) THEN BEGIN
  86.         Inc(lnx1, lnxi);
  87.         Inc(lndd, lnai);
  88.       END ELSE inc(lndd, lnbi);
  89.       Inc(lny1, lnyi);
  90.       SetPixel(lnx1, lny1, Colour);
  91.     UNTIL (lny1 = lny2);
  92.   END;
  93. END;
  94.  
  95. PROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);
  96. { returns the r, g, and b values of a palette index }
  97. BEGIN
  98.   Port[$3C7] := index2get;
  99.   r_inte := Port[$3C9];
  100.   g_inte := Port[$3C9];
  101.   b_inte := Port[$3C9];
  102. END;
  103.  
  104. PROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);
  105. { sets the r, g, and b values of a palette index }
  106. BEGIN
  107.   Port[$3C8] := index2set;
  108.   Port[$3C9] := r_inte;
  109.   Port[$3C9] := g_inte;
  110.   Port[$3C9] := b_inte;
  111. END;
  112.  
  113. { oh, I'll give credit where credit is due: Sean Palmer supplied the
  114.   Bresenham line and ellipse procedures }
  115.  
  116.  
  117. PROCEDURE BurstSetPalette(burstPalette : RGBPalette);
  118. VAR
  119.   burstCount : Word;
  120. BEGIN
  121.   Port[$3C8] := 0;
  122.   FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];
  123. END;
  124.  
  125. PROCEDURE WaitForRetrace;
  126. { waits for a vertical retrace to reduce flicker }
  127. BEGIN
  128.      (* REPEAT UNTIL (Port[$3DA] AND $08) = 0; *)
  129.      { the above loop has been commented because it is only }
  130.      { necessary to wait until a retrace is in progress }
  131.      REPEAT UNTIL (Port[$3DA] AND $08) <> 0;
  132. END;
  133.  
  134. PROCEDURE ClearScr;
  135. BEGIN
  136.      FillChar(Mem[$A000:0000], 64000, 0);
  137. END;
  138.  
  139. FUNCTION GetOverscan : Byte;
  140. VAR
  141.   tmpOverscanByte : Byte;
  142. BEGIN
  143.   ASM
  144.     MOV AX,$1008
  145.     INT $10
  146.     MOV tmpOverscanByte,BH
  147.   END;
  148.   GetOverscan := tmpOverscanByte;
  149. END;
  150.  
  151. PROCEDURE SetOverscan(borderColour : Byte);
  152. BEGIN
  153.   ASM
  154.     MOV AX,$1001
  155.     MOV BH,borderColour
  156.     INT $10
  157.   END;
  158. END;
  159.  
  160. {
  161. Well, that's basically it, except for the bitmap scaler.  If you want it, let
  162. me know if you can receive NetMail, and I'll send it that way; otherwise, I'll
  163. post.  The last two procedures/functions have not been tested.  In fact, I
  164. can't guarantee that any of the stuff will work.  But try it out...  :^)
  165. C-YA.
  166. }